home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / ai.prl / mike1.exe / FC_EXEC.PL < prev    next >
Encoding:
Text File  |  1990-09-17  |  5.6 KB  |  126 lines
  1. /* file: FC_EXEC.PL {main forward chainer} */
  2. /*                          *************
  3.                                M I K E
  4.                             *************
  5.                Micro Interpreter for Knowledge Engineering
  6.                   {written in Edinburgh-syntax Prolog}
  7.  
  8. MIKE: Copyright (c) 1989, 1990 The Open University (U.K.)
  9.  
  10. MIKE is intended for educational purposes, and may not
  11. be sold as or incorporated in a commercial product without
  12. written permission from: The Copyrights Officer, Open University,
  13. Milton Keynes MK7 6AA, U.K.
  14.  
  15. The Open University accepts no responsibility for any legal or other
  16. consequences which may arise directly or indirectly as a result of the
  17. use of all or parts of the contents of this program.
  18.  
  19. This software accompanies Open University Study Pack PD624, 'KNOWLEDGE
  20. ENGINEERING'.  Complete sets of study pack materials may be obtained from:
  21.  
  22.                       Learning Materials Sales Office
  23.                       The Open University
  24.                       P.O. Box 188
  25.                       Milton Keynes MK7 6DH, U.K.
  26.  
  27.                       Tel: [+44] (908) 653338
  28.                       Fax: [+44] (908) 653744
  29. */
  30. /*============== F O R W A R D  C H A I N I N G  E X E C U T I V E ======= */
  31.  
  32. /* To keep the file ENGINE.PL a manageable size, one part of it (the
  33. main forward-chaining executive control loop) has been placed here. */
  34.  
  35. /* The main interpreter runs in a loop inside forward_chain.  The logic
  36. is deliberately simple, hence vulnerable to rapid deterioration on large
  37. rule sets.  ALL stored rules are gathered up using findall/0, and then
  38. (of those rules), those whose left-hand-side conditions ALL succeed are
  39. regarded as the 'conflict set'.  This latter set is then 'whittled down'
  40. using resolve_conflicts/4.  The unique winner then has its right-hand-side
  41. actions executed using perform/4. Optimisation of this definition would
  42. yield big rewards, especially if Rete network or other type of rule
  43. compilation were employed */
  44.  
  45. /* The essential auxilliary procedures all_in_wm, resolve_conflicts,
  46. and perform are defined in ENGINE.PL */
  47.  
  48. forward_chain:-
  49.     repeat,                      /* cycle until halt is encountered... */
  50.  fc_do_one_cycle(NewWME),     /* workhorse: computes new WM each cycle */
  51.  fc_halt_else_loop(NewWME).   /* bails out only if 'halt' is in WM */
  52.  
  53. /* cleanup below is invoked by initialise and part_initialise */
  54. fc_reset_history :-
  55.  abolish('pd624 fc_history',3),        /* tidy up stuff for ?- show history. */
  56.  abolish('pd624 current cycle is',1),  /* ditto */
  57.  asserta('pd624 current cycle is'(0)). /* ditto */
  58.  
  59. fc_do_one_cycle(NewWME) :-   /* NewWME is OUTPUT (New Working Memory Elements) */
  60.    fc_update_counters(WME),  /* fetch current WM, update cycle counter */
  61.    findall1((rule RULE forward if COND then ACTIONS), /* given this pattern */
  62.             fc_good_potential(RULE,COND,ACTIONS), /* round up candidates */
  63.             ConfSet),                             /* put into conflict set */
  64.    fc_pick_one_and_do_it(ConfSet,WME,NewWME),     /* choose one winner */
  65.    !.
  66.  
  67.  
  68. fc_update_counters(WME) :- /* cycle counter gets globally incremented */
  69.    retract('pd624 wme'(WME)), /* this retrieves latest working memory */
  70.    retract('pd624 current cycle is'(CURRCYCLENUM)),
  71.    NEWCYCLENUM is CURRCYCLENUM + 1,
  72.    asserta('pd624 current cycle is'(NEWCYCLENUM)).
  73.  
  74. fc_pick_one_and_do_it(ConfSet,WME,NewWME) :-  /* third arg is OUTPUT */
  75.    current_conflict_resolution_strategy(Strategy),
  76.    when_enabled('show conflict set' for ConfSet),
  77.    resolve_conflicts(ConfSet, /* whole set goes in, only next one comes out */
  78.                      (rule Rule forward if Cond then Actions), /* This one */
  79.                      WME,
  80.                      Strategy),
  81.    when_enabled('show conflict winner' for Rule), /* shorthand winner */
  82.    when_enabled('show history on request' for [Rule,'*']),
  83.    when_enabled('show chosen rule'
  84.                  for [(rule Rule forward if Cond then Actions)]),
  85.      /* PATCH 10 SEP 90  assert --> asserta for possible TMS in future */
  86.    asserta(already_did(Rule,Cond)), /* tell me you just did it */
  87.    fc_do_rhs(WME,NewWME,Rule,Cond,Actions), /* execute RHS actions */
  88.    when_enabled('show new working memory elements or frame changes'
  89.                  for NewWME).
  90.  
  91. fc_good_potential(RULE,COND,ACTIONS) :-  /* a rule enters conflict set if... */
  92.    (rule RULE forward if COND then ACTIONS), /* given this form in database... */
  93.    when_enabled('show single stepping in' for RULE),
  94.    all_in_wm(COND), /* all of its left-hand-side conditions are satisfied */
  95.    when_enabled('show single stepping out' for RULE),
  96.    when_enabled('show history on request' for [RULE,'+']).
  97.  
  98. fc_do_rhs(WME,NewWME,Rule,Cond,Actions) :- /* case 1: nothing to do */
  99.   Actions = 'no thens',
  100.   NewWME = [halt],
  101.   write('No applicable rules'), nl, /* no applicable rule so halt */
  102.   !.
  103.  
  104. fc_do_rhs(WME,NewWME,Rule,Cond,Actions) :- /* case 2: normal execution */
  105.   perform(Actions,NewWME,Rule,Cond), /* execute RHS actions */
  106.   !.
  107.  
  108. fc_do_rhs(WME,NewWME,Rule,Cond,Actions) :- /* case 3: perform/4 failed somehow */
  109.   write('WARNING: rule '),write(Rule),
  110.   write(' right-hand-side action failed. '),
  111.   nl,
  112.   tab11_write(Actions),
  113.   nl,
  114.   NewWME = WME.
  115.  
  116. fc_halt_else_loop(NewWME) :-       /* halt encountered, so finish off */
  117.    ( 'pd624 member'(halt,NewWME) ; currentdb(halt,true) ) ,
  118.    !,
  119.    write('Production system halted'),
  120.    nl.  /* end of processing, nothing more to do */
  121.  
  122. fc_halt_else_loop(NewWME) :-    /* no halt, so cause failure-driven loop */
  123.    assert('pd624 wme'(NewWME)),
  124.    fail.      /* fail straight back to repeat */
  125.  
  126.